home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue34 / 34com / XDesktopImpl.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-05-12  |  3.1 KB  |  132 lines

  1. unit XDesktopImpl;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, AxDesktop_TLB, Desktop, DeskProp;
  8.  
  9. type
  10.   TXDesktop = class(TActiveXControl, IXDesktop)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TDesktop;
  14.     FEvents: IXDesktopEvents;
  15.   protected
  16.     { Protected declarations }
  17.     procedure InitializeControl; override;
  18.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  19.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  20.     function Get_Font: Font; safecall;
  21.     function Get_ItemCount: Integer; safecall;
  22.     function Get_TextBackgroundColor: TColor; safecall;
  23.     function Get_TextColor: TColor; safecall;
  24. //    function Get_WeenyVisible: WordBool; safecall;
  25.     procedure AboutBox; safecall;
  26.     procedure Set_Font(const Value: Font); safecall;
  27.     procedure Set_ItemCount(Value: Integer); safecall;
  28.     procedure Set_TextBackgroundColor(Value: TColor); safecall;
  29.     procedure Set_TextColor(Value: TColor); safecall;
  30. //    procedure Set_WeenyVisible(Value: WordBool); safecall;
  31.     function Get_Visible: WordBool; safecall;
  32.     procedure Set_Visible(Value: WordBool); safecall;
  33.   end;
  34.  
  35. implementation
  36.  
  37. uses SysUtils, About1;
  38.  
  39. { TXDesktop }
  40.  
  41. procedure TXDesktop.InitializeControl;
  42. begin
  43.   FDelphiControl := Control as TDesktop;
  44.   FDelphiControl.Visible := False;
  45. end;
  46.  
  47. procedure TXDesktop.EventSinkChanged(const EventSink: IUnknown);
  48. begin
  49.   FEvents := EventSink as IXDesktopEvents;
  50. end;
  51.  
  52. procedure TXDesktop.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  53. begin
  54.     DefinePropertyPage (Class_DesktopProp);
  55. end;
  56.  
  57. function TXDesktop.Get_Font: Font;
  58. begin
  59.   GetOleFont(FDelphiControl.Font, Result);
  60. end;
  61.  
  62. function TXDesktop.Get_ItemCount: Integer;
  63. begin
  64.   Result := FDelphiControl.ItemCount;
  65. end;
  66.  
  67. function TXDesktop.Get_TextBackgroundColor: TColor;
  68. begin
  69.   Result := FDelphiControl.TextBackgroundColor;
  70. end;
  71.  
  72. function TXDesktop.Get_TextColor: TColor;
  73. begin
  74.   Result := FDelphiControl.TextColor;
  75. end;
  76.  
  77. //function TXDesktop.Get_WeenyVisible: WordBool;
  78. //begin
  79. //  Result := FDelphiControl.Visible;
  80. //end;
  81.  
  82. procedure TXDesktop.AboutBox;
  83. begin
  84.   ShowXDesktopAbout;
  85. end;
  86.  
  87. procedure TXDesktop.Set_Font(const Value: Font);
  88. begin
  89.   SetOleFont(FDelphiControl.Font, Value);
  90. end;
  91.  
  92. procedure TXDesktop.Set_ItemCount(Value: Integer);
  93. begin
  94.   FDelphiControl.ItemCount := Value;
  95. end;
  96.  
  97. procedure TXDesktop.Set_TextBackgroundColor(Value: TColor);
  98. begin
  99.   FDelphiControl.TextBackgroundColor := Value;
  100. end;
  101.  
  102. procedure TXDesktop.Set_TextColor(Value: TColor);
  103. begin
  104.   FDelphiControl.TextColor := Value;
  105. end;
  106.  
  107. //procedure TXDesktop.Set_WeenyVisible(Value: WordBool);
  108. //begin
  109. //  FDelphiControl.Visible := Value;
  110. //end;
  111.  
  112. function TXDesktop.Get_Visible: WordBool;
  113. begin
  114.   Result := FDelphiControl.Visible;
  115. end;
  116.  
  117. procedure TXDesktop.Set_Visible(Value: WordBool);
  118. begin
  119.   FDelphiControl.Visible := Value;
  120. end;
  121.  
  122. initialization
  123.   TActiveXControlFactory.Create(
  124.     ComServer,
  125.     TXDesktop,
  126.     TDesktop,
  127.     Class_XDesktop,
  128.     1,
  129.     '',
  130.     0);
  131. end.
  132.